home *** CD-ROM | disk | FTP | other *** search
- /*********************************************************************
- *
- * *** HAPPy Pascal Compiler ***
- * program,block コンパイル処理
- *
- * void programme(void)
- * void block(Set fsys,enum symbol fsy,ctp *fprocp)
- *
- * Copyright (c) H.Asano 1992,1994.
- *
- *********************************************************************/
-
- #define EXTERN extern
- #include <stdlib.h>
- #include <string.h>
- #include "pascomp.h"
- #include "pcpcd.h"
-
- void block(Set,enum symbol,ctp*) ;
- static void body(Set,ctp*) ;
- static void paramcopy(ctp*) ;
- static void statement(Set) ;
- static void compoundstatement(Set) ;
- static void ifstatement(Set) ;
- static void whilestatement(Set) ;
- static void repeatstatement(Set) ;
- static void forstatement(Set) ;
- static void forident(attr*) ;
- static void forexpres1(Set,attr);
- static void forexpres2(Set,attr,enum symbol,int*,int*) ;
- static void fordostatement(Set,attr,enum symbol,int) ;
- static void assignment(Set,ctp*) ;
- static void casestatement(Set) ;
- static void withstatement(Set) ;
- static void gotostatement(Set) ;
- extern void call(Set,ctp*) ;
- extern void expression(Set) ;
- extern void selector(Set,ctp*) ;
- extern ctp *mkctp(char*,enum idclass,stp*,ctp*) ;
- extern void enterid(ctp*) ;
- extern ctp *searchid(Set);
- extern ctp *searchsection(ctp*) ;
- extern void insymbol(void);
- extern void skip(Set) ;
- extern void updatelc(int) ;
- extern void pcerr(int,char*) ;
- extern char *inttoch(long) ;
- extern char *inttoch(long) ;
- extern char *inttoch(long) ;
- extern Set *mkset(Set*,int,...) ;
- extern Set *orset(Set*,Set*) ;
- extern Set *dfset(Set*,Set*) ;
- extern int crelabel(void) ;
- extern void labeldecl(Set);
- extern void constdecl(Set);
- extern void typedecl(Set);
- extern void vardecl(Set,ctp*);
- extern void procfuncdecl(Set,enum symbol,ctp**);
- extern void gencupejp(enum pcdmnc, int, int) ;
- extern void genjump(enum pcdmnc,int) ;
- extern void putlabel(int) ;
- extern void genent(void) ;
- extern void genret(stp*) ;
- extern void putprogname(char*);
- extern void putentv(int,int) ;
- extern void putq(void) ;
- extern void gen0(enum pcdmnc) ;
- extern void genp(enum pcdmnc, int) ;
- extern void gen0t(enum pcdmnc,stp*) ;
- extern void gen1t(enum pcdmnc,stp*,int) ;
- extern void gen2t(enum pcdmnc,stp*,int,int) ;
- extern void genlda(int,int) ;
- extern void genldc(char,long) ;
- extern void genchk(stp*,int,long,long) ;
- extern void convertint(stp*) ;
- extern void load(void) ;
- extern void loadaddress(void) ;
- extern void store(attr) ;
- extern void gencompare(enum pcdmnc,char,int) ;
- extern void getbounds(stp*,long*,long*) ;
- extern void checkbounds(stp*,int) ;
- extern boolean compatible(stp*,stp*) ;
- extern boolean assigncompati(stp*,stp*) ;
- extern int align(stp*,int) ;
- extern void constant(Set,stp**,union valu*) ;
- extern void *Malloc(int) ;
-
- static int lcmax ;
- static int mainlabel ; /* メインブロックのラベル値 */
-
- /*******************************************************
- * programme() : program の 処理
- * 形式は、次の2通り
- * program ident( filename,filename,・・・ ) ;
- * program ident;
- *******************************************************/
- void programme(void)
- {
- extfilep *extfp ; /* ファイル名格納エリアのポインタ */
- Set fsys ; /* block で 最初に現れるsymbolの集合*/
- Set casesys; /* casesyだけの集合 (ワーク) */
- ctp *cp ; /* input,output名前登録用 */
- int i ;
- int adr ;
- boolean err196 ;
-
- fextfilep = nil ;
-
- insymbol() ; /* 最初のsymbolを読む */
-
- if(sy == progsy) {
- insymbol();
- if(sy != ident) pcerr(2,""); /* 名前がない */
- putprogname(id) ; /* プログラム名の出力 */
- insymbol();
- if((sy != lparent) && (sy != semicolon))
- pcerr(14,""); /* ; がない */
-
- if(sy == lparent) { /* プログラム引数の処理 */
- do {
- insymbol();
- if(sy == ident) {
- err196 = false ;
- extfp = fextfilep ;
- while(extfp) { /* 重複指定チェック */
- if(!strcmp(extfp->filename,id)) {
- pcerr(196,id) ; /* プログラム引数に同じ名前 */
- err196 = true ;
- }
- extfp = extfp->nextfile ;
- }
- if(!err196) {
- if(!(i=strcmp(id,"input")) || !(strcmp(id,"output"))) {
- if(i!=0) { /* outputの時 */
- adr = outputadr ;
- defineoutput = true ; /* outputファイル定義済 */
- }
- else { /* inputの時 */
- adr = inputadr ;
- defineinput = true ; /* inputファイル定義済 */
- }
- cp = mkctp(id,vars,textptr,nil) ;
- cp->n.v.vkind = actual ;
- cp->n.v.vlev = level ;
- cp->n.v.vaddr = adr ;
- enterid(cp);
- }
-
- extfp = (extfilep*)Malloc(sizeof(extfilep)) ;
- strcpy(extfp->filename,id);
- extfp->nextfile = fextfilep ;
- fextfilep = extfp ;
- }
-
- insymbol() ;
- if((sy != comma) && (sy != rparent))
- pcerr(20,"") ; /* , がない */
- }
- else pcerr(2,"") ; /* 名前がない */
- } while(sy == comma);
- if(sy != rparent) pcerr(14,""); /* ; がない */
- insymbol();
- }
- if(sy!=semicolon) pcerr(14,""); /* ; がない */
- else insymbol();
- }
- else pcerr(3,"") ; /* program がない */
-
- fsys = blockbegsys ; /* fsys = blockbegsys */
- orset(&fsys,&statbegsys) ; /* + statbegsys */
- mkset(&casesys,casesy,-1) ;
- dfset(&fsys,&casesys) ; /* - casesy */
-
- do { /* 誤り回復のためrepeat */
- block(fsys,period,nil) ; /* block の コンパイル */
- if(sy != period) pcerr(21,"") ; /* *がない */
- } while(sy != period) ;
-
- }
-
- /**************************************/
- /* block() : block の 翻訳 */
- /**************************************/
- void block(Set fsys, /* blockに最初に現れるsymbolの集合 */
- enum symbol fsy, /* blockの終わりのsymbol */
- ctp *fprocp) /* proc/funcの名前ポインタ(mainはnil) */
-
- {
- enum symbol lsy ;
- Set bodyfsys ;
- ctp *pffwdptr = nil ; /* 手続き・関数の前方宣言リスト*/
- ctp *lcp ;
- extfilep *extp ; /* プログラム引数リスト */
-
- do { /* declare partの処理 */
- if(sy == labelsy) {
- insymbol() ;
- labeldecl(fsys) ; /* label節の処理 */
- }
- if(sy == constsy) {
- insymbol() ;
- constdecl(fsys) ; /* const節の処理 */
- }
- if(sy == typesy) {
- insymbol() ;
- typedecl(fsys) ; /* type節の処理 */
- }
- if(sy == varsy) {
- insymbol() ;
- vardecl(fsys,fprocp) ; /* var節の処理 */
- } ;
-
- if(fprocp == nil) { /* メインブロックの時 */
- extp = fextfilep ;
- while(extp) { /* プログラム引数の宣言チェック*/
- strcpy(id,extp->filename) ;
- lcp = searchsection(display[level].fname) ;
- if(!lcp) pcerr(197,id) ; /* プログラム引数が未宣言 */
- extp = extp->nextfile ;
- }
-
- genp(iMST,0) ; /* mst命令の生成 */
- mainlabel = crelabel() ; /* メインブロックのラベル名 */
- gencupejp(iCUP,0,mainlabel ) ; /* cup命令の生成 */
- gen0(iSTP) ; /* stp命令の生成 */
-
- }
-
- while((sy == procsy) || (sy == funcsy)) {
- lsy = sy ;
- insymbol() ;
- procfuncdecl(fsys,lsy,&pffwdptr) ;/* 手続き・関数の宣言処理 */
- } ;
-
- while(pffwdptr) { /* 手続き・関数の前方宣言チェック*/
- pcerr(118,pffwdptr->name) ; /* 前方宣言の実体がない */
- pffwdptr = pffwdptr->n.pf.sd.d.af.a.fwdptr ;
- }
-
- if(sy != beginsy) {
- pcerr(18,"") ; /* 宣言部に誤りがある */
- skip(fsys) ;
- } ;
-
- } while(! inset(statbegsys,sy)) ; /* 誤り回復のため繰り返し */
-
- if(sy == beginsy) insymbol() ;
- else pcerr(17,"") ; /* begin がない */
-
- bodyfsys = fsys ;
- addset(bodyfsys,casesy) ;
- do {
- body(bodyfsys,fprocp) ; /* begin ~ end の処理 */
- if(sy != fsy) {
- pcerr(6,"") ; /* 不当な記号が現れた */
- skip(fsys) ;
- }
- } while((sy != fsy) && (! inset(blockbegsys,sy))) ;
- }
-
- /**************************************/
- /* body() : body部 の 翻訳 */
- /**************************************/
- static void body(Set fsys,ctp *fprocp)
- {
- lbp *llp ;
- int entname ;
- Set statementfsys ;
- boolean test ;
-
- topnew = topmax = lcaftermarkstack ;
- entname = (!fprocp) ? mainlabel /* mainのbodyの時 */
- : fprocp->n.pf.sd.d.af.a.pfname ; /* 手続き・関数のラベル値*/
-
- putlabel(entname) ; /* ラベルの出力 */
- genent() ;
-
- if(fprocp) paramcopy(fprocp) ; /* 手続き・関数の時 仮引数を
- スタックにコピーする */
- lcmax = lc ;
-
- /**** statement の 処理 ****/
-
- statementfsys = fsys ; /* statementfsys = */
- addset(statementfsys,semicolon); /* fsys + semicolon */
- addset(statementfsys,endsy) ; /* + endsy */
- do {
- do {
- statement(statementfsys);
- } while(inset(statbegsys,sy)) ;
- if(test=(sy == semicolon)) insymbol() ; /* ; ならば次のsymbolを読む */
- } while(test) ; /* ; ならば繰り返す */
- if(sy == endsy) insymbol() ;
- else pcerr(13,"") ; /* end がない */
-
- /**** ラベルの定義チェック ****/
-
- llp = display[top].flabel;
- while(llp) { /* 宣言られたラベルについて */
- if(!llp->defined) /* 未定義 */
- pcerr(168,inttoch((long)llp->labval)); /* ラベル未出現 */
- llp = llp->nextlab ;
- }
-
- if(fprocp) { /* 手続き・関数内のブロックの時*/
- genret(fprocp->idtype) ; /* 型に応じたret命令生成 */
- if(fprocp->klass == func) /* 関数の時 */
- if(!display[top].funcassign) /* 関数名への代入がない時 */
- pcerr(176,fprocp->name) ; /* 関数名への代入がない */
- }
- else genret(nil) ; /* mainブロックの時はretp命令 */
-
- putentv(topmax,lcmax) ;
- if(!fprocp) putq() ; /* mainブロックの時 q指令を出力*/
-
- }
-
- /**************************************/
- /* paramcopy() : 値引数のコピー処理 */
- /**************************************/
- static void paramcopy(ctp *fprocp)
- {
- ctp *lcp ;
- int llc ;
-
- llc = lcaftermarkstack ;
- lcp = fprocp->next ; /* 引数の先頭 */
-
- while(lcp) {
- llc = align(parmptr,llc) ; /* 境界調整 */
- if(lcp->klass == vars) /* 変数の時 */
- if(lcp->idtype)
- if(lcp->idtype->form > power) { /* 配列・レコード型 */
- if(lcp->n.v.vkind == actual) { /* 値引数 */
- genlda(0,lcp->n.v.vaddr) ; /* lda命令 */
- gen2t(iLOD,nilptr,0,llc) ; /* lod命令 */
- gen2t(iMOV,nil,1,lcp->idtype->size); /* mov命令 */
- }
- llc += ptrsize ;
- }
- else llc += lcp->idtype->size ; /* スカラ、範囲、集合、ポインタ */
- lcp = lcp->next ;
- }
- }
-
- /**************************************/
- /* statement() : 文 の コンパイル */
- /**************************************/
- static void statement(Set fsys)
- {
- Set ws ;
- Set statfolsys ; /* 文の後に続くsymbolの集合 */
- Set identsys ; /* 名前の集合 */
- ctp *lcp ;
- lbp *llp ;
-
- mkset(&statfolsys, semicolon,endsy,elsesy,untilsy,-1);
- mkset(&identsys, vars,field,func,proc,-1) ;
-
- /**** label の 処理 ****/
- if(sy == intconst) {
- llp = display[level].flabel ;
- while(llp) {
- if(llp->labval == (int)val.ival) { /* 宣言されたラベルの時 */
- if(llp->defined)
- pcerr(165,inttoch(val.ival));/* ラベルが再度宣言された */
- putlabel(llp->labname) ; /* ラベル値の出力 */
- llp->defined = true ; /* 定義済 */
- break ;
- }
- else llp = llp->nextlab ; /* ラベル名が違う時 */
- }
- if(!llp)
- pcerr(167,inttoch(val.ival)); /* ラベルが未宣言 */
- insymbol() ;
- if(sy == colon) insymbol() ;
- else pcerr(5,"") ; /* : がない */
- }
-
- /***********************/
-
- if((! inset(fsys,sy)) && (sy != ident)) { /* 許されないsymbolの時 */
- pcerr(6,"") ; /* 不当なsymbolが現れた */
- skip(fsys) ;
- }
- if((inset(fsys,sy)) || (sy == ident)) { /* 文の最初としてOKの時 */
- switch(sy) {
- case ident : lcp=searchid(identsys) ;
- insymbol() ;
- if(lcp->klass != proc)
- assignment(fsys,lcp) ; /* 代入文の処理 */
- else if((lcp->klass == proc) &&
- (inset(statfolsys,sy) || (sy == lparent)))
- call(fsys,lcp) ; /* 手続きのみ呼出 */
- else {
- pcerr(6,"") ; /* 不当な記号が現れた */
- ws = fsys ;
- orset(&ws,&statfolsys) ;
- skip(ws) ; /* 読み飛ばし */
- }
- break ;
- case beginsy : insymbol() ;
- compoundstatement(fsys) ;
- break ;
- case gotosy : insymbol() ;
- gotostatement(fsys) ;
- break ;
- case ifsy : insymbol() ;
- ifstatement(fsys) ;
- break ;
- case casesy : insymbol() ;
- casestatement(fsys) ;
- break ;
- case whilesy : insymbol() ;
- whilestatement(fsys) ;
- break ;
- case repeatsy : insymbol() ;
- repeatstatement(fsys) ;
- break ;
- case forsy : insymbol() ;
- forstatement(fsys) ;
- break ;
- case withsy : insymbol() ;
- withstatement(fsys) ;
- }
-
- if(! inset(statfolsys,sy)) {
- pcerr(6,"") ; /* 不当な記号が現れた */
- skip(fsys) ;
- }
- }
- }
-
- /***************************************/
- /* compoundstatement() : begin文の処理 */
- /***************************************/
- static void compoundstatement(Set fsys)
- {
- Set ws;
- boolean test;
-
- do {
- do {
- mkset(&ws,semicolon,endsy,-1);
- orset(&ws,&fsys) ;
- statement(ws) ;
- } while(inset(statbegsys,sy)) ; /* statement以外がでてきた時終わり*/
- if(test = (sy == semicolon)) insymbol() ; /* ; ならば次のsymbol */
- } while(test) ; /* ; ならば繰り返す */
-
- if(sy == endsy) insymbol() ; /* end ならば次のsymbol */
- else pcerr(13,"") ; /* end がない */
- }
-
- /***************************************/
- /* gotostatement() : goto文の処理 */
- /***************************************/
- static void gotostatement(Set fsys)
- {
- lbp *llp ;
- int ttop,ttop1 ;
- boolean found ;
-
- if(sy == intconst) { /* ラベルは整数 */
- found = false ;
- ttop = top ;
- while(display[ttop].occur != blck)
- ttop-- ; /* block水準を探す */
- ttop1 = ttop ;
- do {
- llp = display[ttop].flabel ;
- while(llp) {
- if(llp->labval == (int)val.ival) { /* ラベル値が同じ */
- found = true ;
- if(ttop == ttop1) /* ラベルの定義水準と同じ */
- genjump(iUJP,llp->labname) ; /* ujp命令 */
- else
- gencupejp(iEJP,level-ttop,llp->labname); /* ejp命令 */
- break ; /* whileループを抜ける */
- }
- else llp = llp->nextlab ;
- }
- ttop-- ;
- } while((! found) && (ttop != 0)) ;
- if(! found)
- pcerr(167,inttoch(val.ival)); /* ラベルが未宣言 */
- insymbol() ;
- }
- else pcerr(164,"") ; /* ラベルが整数でない */
- }
-
- /***************************************/
- /* ifstatement() : if文の処理 */
- /***************************************/
- static void ifstatement(Set fsys)
- {
- int lcix1,lcix2 ;
- Set ws ;
-
- ws = fsys ;
- addset(ws,thensy) ;
- expression(ws) ; /* ifの次の式を評価 */
- load() ; /* 式の値をloadする */
- if(gattr.typtr)
- if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
- pcerr(146,"if文") ; /* 演算対象は論理型でないと駄目*/
- lcix1 = crelabel() ;
- genjump(iFJP,lcix1) ; /* 偽ならelseまたはifの終わりに飛ぶ*/
-
- if(sy == thensy) insymbol() ;
- else pcerr(52,"") ; /* then がない */
-
- ws = fsys ;
- addset(ws,elsesy) ;
- statement(ws) ; /* thenの次の文を処理 */
-
- if(sy == elsesy) {
- lcix2 = crelabel() ;
- genjump(iUJP,lcix2) ; /* elseの終わりまで飛ぶ */
- putlabel(lcix1) ; /* elseのラベル出力 */
- insymbol() ;
- statement(fsys) ; /* elseの次の文を処理 */
- putlabel(lcix2) ; /* elseの終わりのラベル出力 */
- }
- else putlabel(lcix1) ; /* elseがない時 if文の終わりのラベル*/
- }
-
- /***************************************/
- /* whilestatement() : while文の処理 */
- /***************************************/
- static void whilestatement(Set fsys)
- {
- int laddr ; /* 戻りラベル値 */
- int lcix ; /* 飛び越しラベル値 */
- Set ws ;
-
- laddr = crelabel() ; /* ラベル値を得る */
- putlabel(laddr) ; /* ラベル値の出力 */
-
- ws = fsys ;
- addset(ws,dosy) ;
- expression(ws) ; /* whileの次の式の評価 */
- load() ; /* 式の値をloadする */
- if(gattr.typtr)
- if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
- pcerr(146,"while文") ; /* 演算対象は論理型でないと駄目*/
- lcix = crelabel() ; /* 飛び越しラベル値を得る */
- genjump(iFJP,lcix) ; /* fjp命令の生成 */
- if(sy == dosy) insymbol() ;
- else pcerr(54,"") ; /* do がない */
-
- statement(fsys) ; /* 文の処理 */
-
- genjump(iUJP,laddr); /* ujp命令でwhile文の先頭に戻る*/
-
- putlabel(lcix) ; /* 飛び先ラベルの出力 */
- }
-
- /*****************************************/
- /* repeatstatement() : repeat文の処理 */
- /*****************************************/
- static void repeatstatement(Set fsys)
- {
- int laddr ; /* 戻りラベル値 */
- Set ws ;
- boolean test ;
-
- laddr = crelabel() ; /* ラベル値を得る */
- putlabel(laddr) ; /* ラベル値の出力 */
-
- mkset(&ws,semicolon,untilsy,-1);
- orset(&ws, &fsys) ;
- do {
- do {
- statement(ws) ; /* 文の処理 */
- if(inset(statbegsys,sy))
- pcerr(14,"") ; /* ; がない */
- } while(inset(statbegsys,sy)); /* 文として正しいsymbolならリピート */
- if(test = (sy==semicolon)) insymbol() ; /* ; ならば次のsymbol */
- } while(test) ; /* ; ならば繰り返す */
-
- if(sy == untilsy) {
- insymbol() ;
- expression(fsys) ; /* untilに続く式の評価 */
- load() ; /* 式の値をloadする */
- if(gattr.typtr)
- if(gattr.typtr != boolptr) /* 式の値がbooleanでない時 */
- pcerr(146,"repeat文") ; /* 式は論理式でない */
- genjump(iFJP,laddr) ; /* fjp命令の生成 */
- }
- else pcerr(53,"") ; /* until がない */
- }
-
- /***************************************/
- /* forstatement() : for文のコンパイル */
- /***************************************/
- static void forstatement(Set fsys)
- {
- attr lattr ;
- int llc ;
- enum symbol lsy ;
- int looplabel ; /* for文のループ用ラベル値 */
- int forendlabel; /* for文終了の飛び先ラベル値 */
- Set ws ;
-
- llc = lc ; /* 変数割りつけ状況を退避 */
- lattr.typtr = nil ; /* 制御変数の属性初期設定 */
- lattr.kind = varbl ;
- lattr.access = drct ;
- lattr.vlevel = level ;
- lattr.dplmt = 0 ;
-
- if(sy == ident) forident(&lattr) ;
- else {
- pcerr(2,"") ; /* 名前がない */
- mkset(&ws,becomes,tosy,downtosy,dosy,-1) ;
- orset(&ws,&fsys) ;
- skip(ws) ; /* 読み飛ばし */
- }
-
- if(sy == becomes) forexpres1(fsys,lattr) ; /* 式1の処理 */
- else {
- pcerr(51,"") ; /* := がない */
- mkset(&ws,tosy,downtosy,dosy,-1) ;
- orset(&ws,&fsys) ;
- skip(ws) ; /* 読み飛ばし */
- }
-
- if((sy == tosy) || (sy == downtosy)) {
- lsy = sy ; /* to か downsyを後で判断するため退避*/
- forexpres2(fsys,lattr,lsy,&looplabel,&forendlabel) ; /* 式2の処理 */
- }
- else {
- pcerr(55,"") ; /* to / downto がない */
- mkset(&ws,dosy,-1) ;
- orset(&ws,&fsys) ;
- skip(ws) ; /* 読み飛ばし */
- }
-
- if(sy == dosy) insymbol() ;
- else pcerr(54,"") ; /* do がない */
-
- fordostatement(fsys,lattr,lsy,looplabel) ; /* doに続く文の処理*/
-
- putlabel(forendlabel) ; /* for文の終わりラベル出力 */
-
- lc = llc ; /* 一時変数を開放 */
- }
-
- /***************************************/
- /* forident() : for文の制御変数処理 */
- /***************************************/
- static void forident(attr *fattr)
- {
- ctp *lcp ;
- Set ws ;
- int ltop ;
-
- mkset(&ws,vars,-1) ;
- lcp = searchid(ws) ; /* 変数の中から名前を探す */
-
- (*fattr).typtr = lcp->idtype ; /* 変数の型 */
- (*fattr).kind = varbl ;
- if(lcp->n.v.vkind == actual) { /* 実変数ならばOK */
- (*fattr).access = drct ;
- (*fattr).vlevel = lcp->n.v.vlev ; /* 変数の宣言レベル */
- (*fattr).dplmt = lcp->n.v.vaddr; /* 変数の割りつけアドレス */
- ltop = top ;
- while(display[ltop].occur != blck) /* block水準を探す */
- ltop-- ;
- if(lcp->n.v.vlev != ltop) /* 制御変数の定義水準が */
- pcerr(186,id) ; /* for文と同一ぶろっくでない */
- }
- else {
- pcerr(187,id) ; /* 変数引数を制御変数に使えない */
- (*fattr).typtr = nil ;
- }
-
- if((*fattr).typtr)
- if(((*fattr).typtr->form > subrange) || /* ポインタ型、集合型、 */
- /* レコード型、ファイル型*/
- (realptr == (*fattr).typtr)) { /* またはreal型 */
- pcerr(188,id) ; /* 制御変数の型が不当 */
- (*fattr).typtr = nil ;
- }
-
- insymbol() ;
- }
-
- /***************************************/
- /* forexpres1() : for文の式1処理 */
- /* for 制御変数:=式1 ・・・・ */
- /***************************************/
- static void forexpres1(Set fsys,attr fattr)
- {
- Set ws ;
-
- insymbol() ;
-
- mkset(&ws,tosy,downtosy,dosy,-1) ;
- orset(&ws,&fsys) ;
- expression(ws) ; /* 式1を評価 */
-
- if(gattr.typtr)
- if((gattr.typtr->form != scalar) || (gattr.typtr == realptr))
- pcerr(144,"for文の初期値") ;/* 式が順序式でない */
- else if(compatible(fattr.typtr,gattr.typtr)) { /* 制御変数と型が同じ*/
- load() ; /* 式の値をload */
- store(fattr) ; /* 制御変数域にstore */
- }
- else pcerr(145,"初期値") ; /* 制御変数と初期値の型が不適合*/
- }
-
- /****************************************/
- /* forexpres2() : for文の式2処理 */
- /* for ・・・ to/downto 式2 do ・・・ */
- /****************************************/
- static void forexpres2(Set fsys,attr fattr,
- enum symbol fsy,int *flooplabel,int *forendlabel)
- {
- stp *lspfin ;
- char typind ; /* gencompareに引き渡す型文字 */
- int tempadr ; /* 一時変数域のアドレス */
- Set ws ;
-
- insymbol() ;
-
- ws = fsys ;
- addset(ws,dosy) ;
- expression(ws) ; /* 式2を評価 */
-
- lspfin = gattr.typtr ; /* 終値の属性を退避 */
- if(lspfin == boolptr) typind = 'b' ; /* boolean */
- else if(lspfin == charptr) typind = 'c' ; /* char */
- else typind = 'i' ; /* integer/列挙型 */
-
- if(lspfin)
- if((lspfin->form != scalar) || (lspfin == realptr))
- pcerr(144,"for文の終値") ; /* 順序式でない */
- else if(compatible(fattr.typtr,lspfin)) { /* 制御変数と型が同じ*/
- load() ; /* 式の値をload */
- updatelc(align(lspfin,lc) - lc) ; /* 境界合わせ */
- tempadr = lc ;
- gen2t(iSTR,lspfin,0,tempadr) ; /* 一時変数域に式の値をstr*/
- *flooplabel = crelabel() ;
- if(!debug) /* debugでないならば */
- putlabel(*flooplabel) ; /* ループラベル出力 */
- gattr = fattr ;
- load() ; /* 制御変数をload */
- gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
- updatelc(lspfin->size) ;
- if(lc > lcmax) lcmax =lc ; /* 最大変数域サイズの更新 */
- (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならeq命令生成 */
- : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
- }
- else pcerr(145,"終値") ; /* 制御変数と終値の型が不適合 */
-
- *forendlabel = crelabel() ; /* for文終了後の飛び先ラベル生成*/
- genjump(iFJP,*forendlabel); /* fjp命令生成 */
-
- if(debug) { /* debugの時 */
- gattr = fattr ;
- load() ; /* 制御変数をload */
- checkbounds(fattr.typtr,52); /* 範囲チェック */
- store(fattr) ;
- gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
- checkbounds(fattr.typtr,53) ; /* 範囲チェック */
- gen2t(iSTR,lspfin,0,tempadr) ; /* 一時変数域に式の値をstr */
-
- putlabel(*flooplabel) ; /* ループラベル出力 */
- gattr = fattr ;
- load() ; /* 制御変数をload */
- gen2t(iLOD,lspfin,0,tempadr) ; /* 一時変数(式2)をload */
- (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならleq命令生成 */
- : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
- genjump(iFJP,*forendlabel); /* fjp命令生成 */
- }
- }
-
- /**********************************************/
- /* fordostatement() : for文のdoに続く文の処理 */
- /* for ・・・ do 文 */
- /**********************************************/
- static void fordostatement(Set fsys,attr fattr,
- enum symbol fsy,int looplabel)
- {
- statement(fsys) ; /* 文の処理 */
- (fsy == tosy) ? gen1t(iNXT,fattr.typtr,fattr.dplmt) /* nxt命令 */
- : gen1t(iNXD,fattr.typtr,fattr.dplmt) ; /* nxd命令 */
- genjump(iUJP,looplabel) ; /* ujp命令で戻る */
- }
-
- /*****************************************/
- /* withstatement() : with文のコンパイル */
- /*****************************************/
- static void withstatement(Set fsys)
- {
- ctp *lcp ;
- int oldlc ; /* lcの退避域 */
- int oldtop ; /* display top の退避域 */
- boolean test ;
- Set ws ;
-
- oldtop = top ; /* 今のdisplayのtopを退避 */
- oldlc = lc ; /* 今のlcを退避 */
-
- do {
- if(sy == ident) {
- mkset(&ws,vars,field,-1) ;
- lcp = searchid(ws) ; /* 名前を変数、フィールド名より探す*/
- insymbol() ;
- }
- else {
- pcerr(2,"") ; /* 名前がない */
- lcp = uvarptr ; /* 未定義用の変数ポインタ */
- }
- mkset(&ws,comma,dosy,-1) ;
- orset(&ws,&fsys) ;
- selector(ws,lcp) ; /* 変数の処理 */
- if(gattr.typtr)
- if(gattr.typtr->form == records)
- if(top < Displimit) { /* displayがまだある時 */
- top++ ;
- display[top].fname = gattr.typtr->sf.re.fstfld ; /* 最初の欄*/
- display[top].flabel = nil ; /* ラベル欄の初期設定 */
- if(gattr.access == drct) { /* 直接参照の時 */
- display[top].occur = crec ; /* 固定部のレコード欄 */
- display[top].clev = gattr.vlevel ; /* 定義水準 */
- display[top].cdspl = gattr.dplmt ; /* 相対アドレス */
- }
- else { /* 間接参照の時 */
- loadaddress() ; /* loadaddress命令 */
- updatelc(align(nilptr,lc)-lc);/* lcの境界調整 */
- gen2t(iSTR,nilptr,0,lc) ; /* str命令 */
- display[top].occur = vrec ; /* 可変レコード欄 */
- display[top].vdspl = lc ; /* loadaddress 格納場所 */
- updatelc(ptrsize) ; /* lcを1アドレス分進める */
- if(lc > lcmax) lcmax = lc ;
- }
- }
- else
- pcerr(603,inttoch((long)Displimit));/* 名前の入れ子が深すぎる */
- else pcerr(140,"") ; /* 変数の型がレコードでない */
- if(test = (sy == comma)) insymbol() ; /* , なら次の変数を読む */
- } while(test) ; /* , なら次の変数の処理へ */
-
- if(sy == dosy) insymbol() ;
- else pcerr(54,"") ; /* do がない */
-
- statement(fsys) ; /* with文配下の文の処理 */
-
- top = oldtop ; /* 水準を元に戻す */
- lc = oldlc ; /* lcを元に戻す */
- }
-
- /**************************************/
- /* assignment() : 代入文のコンパイル */
- /**************************************/
- static void assignment(Set fsys,ctp *fcp)
- {
- attr lattr ; /* 1つ前の属性 */
- long lmin,lmax ;
- boolean cstflag ;
- Set ws ;
-
- ws = fsys ;
- addset(ws,becomes) ;
- addset(ws,relop ) ; /* := を = と間違えやすいので
- この場合だけ別エラーにする */
- selector(ws, fcp) ; /* 左辺の処理 */
-
- if(fcp->klass == func) /* 左辺が関数の時 */
- if(fcp->n.pf.pfdeckind == standard) {
- pcerr(150,fcp->name) ; /* 標準関数への代入は駄目 */
- gattr.typtr = nil ;
- }
- else if(fcp->n.pf.sd.d.pfkind == formal)
- pcerr(151,"") ; /* 関数引数への代入は駄目 */
- else if(display[fcp->n.pf.sd.d.pflev+1].funcname != fcp)
- pcerr(177,fcp->name) ; /* ここでは代入できない */
- else display[fcp->n.pf.sd.d.pflev+1].funcassign = true ;
- /* 関数名への代入あり */
-
- if(sy==relop && op==eqop) {
- pcerr(49,"") ; /* = でなく := を使え */
- sy = becomes ; /* := に 置き換える */
- }
- if(sy == becomes) {
- if(gattr.typtr)
- if(gattr.typtr->form == subrange) /* 範囲型の時は 範囲値を */
- getbounds(gattr.typtr,&lmin,&lmax) ;/* 求めておく */
- if((gattr.access != drct) || /* 直接参照でないか */
- (gattr.typtr->form > power)) /* 配列型、レコード型、ファイル型*/
- loadaddress() ; /* の時は、アドレスをのせる */
- lattr = gattr ; /* 左辺を退避 */
- insymbol() ;
- expression(fsys) ; /* 右辺の処理 */
- if(gattr.typtr)
- cstflag = gattr.kind == cst ; /* 右辺が定数の時 真 */
- if(gattr.typtr->form <= power) /* スカラー、範囲、ポインタ、集合*/
- load() ;
- else loadaddress() ;
-
- if((lattr.typtr) && (gattr.typtr)) {
- if((lattr.typtr == realptr) && /* 左辺が実数型で */
- (compatible(gattr.typtr,intptr))) { /* 右辺が整数型の時 */
- gen0(iFLT) ; /* 実数に変換 flt命令 */
- gattr.typtr = realptr ;
- }
-
- if(assigncompati(lattr.typtr,gattr.typtr)) /* 代入可能な時 */
- switch(lattr.typtr->form) { /* 型によって振り分ける */
- case subrange :
- if(cstflag) {
- if((lmin > gattr.cval.ival) || /* コンパイル時に */
- (lmax < gattr.cval.ival)) /* 範囲内チェックを行 */
- pcerr(129,"") ; /* 代入可能でない */
- }
- else checkbounds(lattr.typtr,49) ;/* 実行時にチェック */
- store(lattr) ;
- break ;
- case scalar :
- checkbounds(lattr.typtr,49) ; /* 上限・下限のチェック */
- case pointer :
- store(lattr) ;
- break ;
- case power :
- checkbounds(lattr.typtr,50) ; /* 上限・下限のチェック */
- store(lattr) ;
- break ;
- case arrays :
- case records :
- gen2t(iMOV,nil,1,lattr.typtr->size) ;
- }
- else pcerr(129,"") ; /* 代入可能でない */
- }
- }
- else pcerr(51,"") ; /* := がない */
- }
-
- /*****************************************/
- /* casestatement() : case文のコンパイル */
- /*****************************************/
- typedef struct caseinfo cip ;
- struct caseinfo {
- cip *next ;
- int csstart ; /* P-codeラベル値 */
- long cslab ; /* 定数値 */
- } ;
-
- static void casestatement(Set fsys)
- {
- stp *lsp,*lsp1 ;
- cip *lpt,*lpt1,*lpt2,*lpt3,*fstptr;
- int laddr ;
- int lcix,lcix1;
- long lmin,lmax;
- union valu lval ;
- boolean test ;
- Set ws ;
-
- mkset(&ws,ofsy,comma,colon,-1) ;
- expression(ws) ; /* caseに続く式の処理 */
- load() ; /* 式の値をload */
- lsp = gattr.typtr ;
- if(lsp)
- if((lsp->form != scalar) || (lsp == realptr)) {
- pcerr(144,"case文の選択式") ; /* 順序式でない */
- lsp = nil ;
- }
- else convertint(gattr.typtr) ; /* 必要ならord命令生成 */
-
- lcix = crelabel() ;
- genjump(iUJP,lcix) ; /* 式の値チェックへ飛ぶ */
-
- if(sy == ofsy) insymbol() ;
- else pcerr(8,"") ; /* of がない */
-
- fstptr = nil ;
- laddr = crelabel() ;
- do {
- lpt = nil ;
- lcix1 = crelabel() ;
- do {
- mkset(&ws,comma,colon,-1);
- orset(&ws,&fsys) ;
- constant(ws,&lsp1,&lval) ; /* 定数の処理 */
- if(lsp1)
- if(lsp == lsp1) { /* 式の型と定数の型を比較 */
- /*** 新しい定数を昇順となるようlpt1 と lpt2 の間に挿入する ****/
- lpt1 = fstptr ;
- lpt2 = nil ;
- while(lpt1 != nil) {
- if(lpt1->cslab >= lval.ival) {
- if(lpt1->cslab == lval.ival)/* 前の定数と同じ値の時 */
- pcerr(156,"") ; /* case文の名札が再度定義された*/
- break ;
- }
- lpt2 = lpt1;
- lpt1 = lpt1->next ;
- }
- lpt = (cip*)Malloc(sizeof(cip)) ;
- lpt->next = lpt1 ;
- lpt->cslab = lval.ival ;
- lpt->csstart = lcix1 ;
- if(lpt2==nil) fstptr = lpt ; /* 一度もwhileループを回ってない*/
- else lpt2->next = lpt ;
- if(lpt1==nil) lmax = lval.ival ; /* 定数の最大値 */
- }
- else pcerr(147,"") ; /* case文の名札の型がおかしい */
- if(test=(sy==comma)) insymbol() ;/* , ならば次の定数を読む */
- } while(test) ; /* , ならば次の定数の処理 */
- if(sy == colon) insymbol() ;
- else pcerr(5,"") ; /* : がない */
- putlabel(lcix1) ;
- ws = fsys;
- addset(ws,semicolon) ;
- lpt3 = lpt; /* QuickCのバグのため(lpt破壊)*/
- do { /* 誤り回復のため繰り返し */
- statement(ws) ; /* 定数に対する文の処理 */
- } while(inset(statbegsys,sy));
- if(lpt3) genjump(iUJP,laddr);
- if(test=(sy==semicolon)) insymbol() ;/* ; ならば次の定数を読む */
- if(sy==endsy) break ; /* endなら処理終わり */
- } while(test) ; /* ; ならば次の定数の処理 */
-
- putlabel(lcix) ;
-
- if(fstptr) {
- lmin = fstptr->cslab;
- if(lmax - lmin < Cixmax) {
- genchk(intptr,51,lmin,lmax);
- if(lmin!=0) /* 最小値が0の時はそのまま */
- if(labs(lmin) <=32767) /* qオペランドで表現できる値 */
- gen1t(iDEC,intptr,(int)lmin) ; /* deci 最小値 */
- else { /* 大きな値 */
- genldc('i',lmin); /* ldci lmin */
- gen0(iSBI) ; /* sbi */
- }
- gen0(iXJP) ;
- do {
- while(fstptr->cslab > lmin) {
- gen0(iUJC) ;
- lmin++ ;
- }
- genjump(iUJP,fstptr->csstart);
- fstptr = fstptr->next ;
- lmin++ ;
- } while(fstptr) ;
- putlabel(laddr) ;
- }
- else
- pcerr(601,inttoch((long)Cixmax)) ; /* case文の選択の範囲が大きすぎる*/
- }
-
- if(sy == endsy) insymbol() ;
- else pcerr(13,"") ; /* end がない */
- }